unit DatasourceDlg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Grids, Index, xtasacs, math, tasacsabstract, nasysutil,
  StdActns, ActnList, ifmtextspoolerunit, clipbrd;

type
  TfrmDataSourceDlg = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    gbDimensions: TGroupBox;
    lblLastYear: TLabel;
    ebLastYear: TEdit;
    lblFirstYear: TLabel;
    ebFirstYear: TEdit;
    lblFirstAge: TLabel;
    ebFirstAge: TEdit;
    lblLastAge: TLabel;
    ebLastAge: TEdit;
    sgData: TStringGrid;
    btnApplyDim: TButton;
    lblData: TLabel;
    btnWeightings: TButton;
    Label1: TLabel;
    ebFileName: TEdit;
    ActionList1: TActionList;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    procedure FormCreate(Sender: TObject);
    procedure sgDataGetEditText(Sender: TObject; ACol, ARow: Integer;
      var Value: string);
    procedure btnWeightingsClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnApplyDimClick(Sender: TObject);
    procedure sgDataSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: string);
    procedure sgDataMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure sgDataMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormShow(Sender: TObject);
    procedure EditCopy1Execute(Sender: TObject);
    procedure EditCopy1Update(Sender: TObject);
    procedure EditPaste1Execute(Sender: TObject);
    procedure EditPaste1Update(Sender: TObject);
    procedure sgDataSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure sgDataDrawCell(Sender: TObject; ACol, ARow: Integer;
       Rect: TRect; State: TGridDrawState);
    procedure sgDataKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure sgDataKeyPress(Sender: TObject; var Key: Char);
    procedure sgDataKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    m_BackDlg : TfrmDataSourceDlg;
    m_ObsData : ITasacsObsData;
    m_SelTargetCol, m_SelTargetRow : Integer;
    m_RegisterSelTarget : Boolean;
    m_FirstYear, m_LastYear, m_FirstAge, m_LastAge : Integer;
    m_Pasting : Boolean;
   procedure OptimizeSize;
   function GetSelectionLeft : Integer;
   function GetSelectionTop : Integer;
   function GetSelectionRight : Integer;
   function GetSelectionBottom : Integer;
   function CanSelectCell(ACol, ARow: Integer) : Boolean;
   function GetNumFixedRows : Integer;
  public
    procedure UpdateView;
    constructor Create(AOwner : TComponent; ObsData : ITasacsObsData; BackDlg : TfrmDataSourceDlg); reintroduce;
    { Public declarations }
    procedure SetSelTargetCol(Value : Integer);
    procedure SetSelTargetRow(Value : Integer);
    procedure SetRegisterSelTarget(Value : Boolean);
    property SelTargetCol : Integer read m_SelTargetCol write SetSelTargetCol;
    property SelTargetRow : Integer read m_SelTargetRow write SetSelTargetRow;
    property RegisterSelTarget : Boolean read m_RegisterSelTarget write SetRegisterSelTarget;
  end;

var
  frmDataSourceDlg: TfrmDataSourceDlg;

implementation

{$R *.dfm}


procedure TfrmDataSourceDlg.SetSelTargetCol(Value : Integer);
begin
   m_SelTargetCol := Value;
//   if m_BackDlg <> nil then
//      m_BackDlg.SelTargetCol := Value;
end; // TfrmDataSourceDlg.SetSelTargetCol


procedure TfrmDataSourceDlg.SetSelTargetRow(Value : Integer);
begin
   m_SelTargetRow := Value;
 //  if m_BackDlg <> nil then
 //     m_BackDlg.SelTargetRow := Value;
end; // TfrmDataSourceDlg.SetSelTargetRow


procedure TfrmDataSourceDlg.SetRegisterSelTarget(Value : Boolean);
begin
   m_RegisterSelTarget := Value;
//   if m_BackDlg <> nil then
//      m_BackDlg.RegisterSelTarget := Value;
end; // TfrmDataSourceDlg.SetRegisterSelTarget


constructor TfrmDataSourceDlg.Create(AOwner : TComponent; ObsData : ITasacsObsData; BackDlg : TfrmDataSourceDlg);
var
   I : Integer;
begin
   inherited Create(AOwner);
   m_ObsData := ObsData;
   m_BackDlg := BackDlg;
   m_Pasting := false;
end; // TfrmDataSourceDlg.Create


procedure TfrmDataSourceDlg.EditCopy1Execute(Sender: TObject);
var
   s, elm : string;
   iCol, iRow : Integer;
begin
   for iRow := GetSelectionTop to GetSelectionBottom do
   begin
      for iCol := GetSelectionLeft to GetSelectionRight do
      begin
         sgDataGetEditText(nil, iCol, iRow, elm);
         s := s + elm;
         if iCol < GetSelectionRight then
            s := s + #9;
      end; // for;
      if iRow < GetSelectionBottom then
         s := s + #13#10;
   end; // for
   Clipboard.AsText := s;
end;


procedure TfrmDataSourceDlg.EditCopy1Update(Sender: TObject);
begin
   EditCopy1.Enabled := true;
end;


type PgGridSpooler = class(PgTextSpooler)
private
   m_Grid : TStringGrid;
   m_DataSourceDlg : TfrmDataSourceDlg;
   m_ColOffset, m_RowOffset : Integer;
protected
   function OnCellRead : Boolean; override;
public
   constructor Create(DataSourceDlg : TfrmDataSourceDlg; Grid : TStringGrid; ColOffset, RowOffset : Integer); reintroduce;
end; //  PgGridSpooler


constructor PgGridSpooler.Create(DataSourceDlg : TfrmDataSourceDlg; Grid : TStringGrid; ColOffset, RowOffset : Integer);
begin
   inherited Create([#9], true, '');
   m_Grid := Grid;
   m_DataSourceDlg := DataSourceDlg;
   m_ColOffset := ColOffset;
   m_RowOffset := RowOffset;
end; // PgGridSpooler.Create


function PgGridSpooler.OnCellRead : Boolean;
var
   iCol, iRow : Integer;
begin
   iCol := min(m_Grid.ColCount, m_ColOffset + Col);
   iRow := min(m_Grid.RowCount, m_RowOffset + Row);
   m_DataSourceDlg.m_Pasting := true;
   m_Grid.OnSetEditText(nil, iCol, iRow, Cell);
   m_DataSourceDlg.m_Pasting := false;
   Result := true;
end; // PgGridSpooler.OnCellRead


procedure TfrmDataSourceDlg.EditPaste1Execute(Sender: TObject);
var
   Spooler : PgGridSpooler;
   iRow, iCol : integer;
begin
   for iRow := GetSelectionTop to GetSelectionBottom do
   begin
      for iCol := GetSelectionLeft to GetSelectionRight do
      begin
         Spooler := PgGridSpooler.Create(Self, sgData, max(iCol, 0), max(iRow, 0));
         Spooler.Spool;
         Spooler.Free;
      end; // for
   end; // for
   OptimizeSize;
end;


procedure TfrmDataSourceDlg.EditPaste1Update(Sender: TObject);
begin
   EditPaste1.Enabled := true;
end;


procedure TfrmDataSourceDlg.FormCreate(Sender: TObject);
var
   FirstYear, LastYear, FirstAge, LastAge : Integer;
begin
   SelTargetCol := -1;
   SelTargetRow := -1;
   RegisterSelTarget := false;
   Caption := 'Data editor [' + m_ObsData.Name + ']';
   btnWeightings.Enabled := m_ObsData.Weight <> nil;
   ebFileName.Text := get_Run_Prop_Str(propCaTonFile + (m_ObsData.Category - odCaTon));
   lblFirstAge.Enabled := not (m_ObsData.Category in [odCaTon, odSSB..odBiomassWeight]);
   ebFirstAge.Enabled := lblFirstAge.Enabled;
   lblLastAge.Enabled := lblFirstAge.Enabled;
   ebLastAge.Enabled := lblFirstAge.Enabled;
   UpdateView();
   get_DataSourceDimensions(m_ObsData.Category, m_ObsData._Index, FirstYear, LastYear, FirstAge, LastAge);
   ebFirstYear.Text := inttostr(FirstYear);
   ebLastYear.Text := inttostr(LastYear);
   ebFirstAge.Text := inttostr(FirstAge);
   ebLastAge.Text := inttostr(LastAge);
   sgData.ColCount := 1 + (LastAge - FirstAge + 1)
end; // TfrmDataSourceDlg.FormCreate


procedure TfrmDataSourceDlg.FormShow(Sender: TObject);
begin
   sgData.SetFocus;
end; // TfrmDataSourceDlg.FormShow


function TfrmDataSourceDlg.GetNumFixedRows : Integer;
begin
   if (m_FirstAge = -1) and (m_LastAge = -1) then
      Result := 0
   else
      Result := 1;
end; // TfrmDataSourceDlg.GetNumFixedRows


procedure TfrmDataSourceDlg.UpdateView;
var
   NumYears, NumAges, Year, Age, NumFixedRows : Integer;
   val : double;
   vals : string;
begin
   m_FirstYear := 0;
   m_LastYear := 0;
   m_FirstAge := 0;
   m_LastAge := 0;
   get_DataSourceDimensions(m_ObsData.Category, m_ObsData._Index, m_FirstYear, m_LastYear, m_FirstAge, m_LastAge);
   ebFirstYear.Text := inttostr(m_FirstYear);
   ebLastYear.Text := inttostr(m_LastYear);
   if lblFirstAge.Enabled then
   begin
      ebFirstAge.Text := inttostr(m_FirstAge);
      ebLastAge.Text := inttostr(m_LastAge);
   end;
   NumAges := (m_LastAge - m_FirstAge + 1);
   NumYears := (m_LastYear - m_FirstYear + 1);
   sgData.ColCount := 1 + NumAges;
   sgData.RowCount := GetNumFixedRows + NumYears;
   sgData.FixedRows := GetNumFixedRows;
   for Year := m_FirstYear to m_LastYear do
      sgData.Cells[0, GetNumFixedRows + Year - m_FirstYear] := inttostr(Year);
   if GetNumFixedRows > 0 then
      for Age := m_FirstAge to m_LastAge do
         sgData.Cells[1 + Age - m_FirstAge, 0] := inttostr(Age);
   for Year := m_FirstYear to m_LastYear do
      for Age := m_FirstAge to m_LastAge do
      begin
         val := get_DataSourceValue(m_ObsData.Category, m_ObsData._Index, Year - m_FirstYear, Age - m_FirstAge);
         if m_BackDlg <> nil then
            vals := floattostrex(val, '.', 0, 5)
         else
            vals := floattostr(val);
         sgData.Cells[1 + Age - m_FirstAge, GetNumFixedRows + Year - m_FirstYear] := vals;
      end;
   sgData.TopRow := sgData.RowCount - sgData.VisibleRowCount;
   OptimizeSize;
end;


procedure TfrmDataSourceDlg.OptimizeSize;
var
   MaxW, MaxH : Integer;
   J, I : Integer;
   text : string;
begin
   MaxH := 0;
   if sgData.Enabled then
   begin
      with sgData do
         for J := 0 to ColCount - 1 do
         begin
            MaxW := 0;
            for I := 0 to RowCount - 1 do
            begin
               text := Cells[J, I];
               MaxW := max(MaxW, max(Canvas.TextWidth('000'), Canvas.TextWidth(Text) + 12));
               MaxH := max(MaxH, max(Canvas.TextHeight('000'), Canvas.TextHeight(Text) + 4));
            end; // for
            ColWidths[J] := MaxW;
         end; // for
   end;
   for I := 0 to sgData.RowCount - 1 do
      sgData.RowHeights[I] := MaxH;

   sgData.Invalidate;
   sgData.Update;
end; // TfrmDataSourceDlg.OptimizeSize


procedure TfrmDataSourceDlg.btnApplyDimClick(Sender: TObject);
var
   FirstYear, LastYear, FirstAge, LastAge, Year, Age : Integer;
//   dataarr : array of array of double;
   Val : double;
begin
   FirstYear := round(safestrtofloat(ebFirstYear.Text));
   LastYear := round(safestrtofloat(ebLastYear.Text));
   FirstAge := round(safestrtofloat(ebFirstAge.Text));
   LastAge := round(safestrtofloat(ebLastAge.Text));
   set_DataSourceDimensions(m_ObsData.Category, m_ObsData._Index, FirstYear, LastYear, FirstAge, LastAge);
   if (m_ObsData.Weight <> nil) then
   begin
      set_DataSourceDimensions(m_ObsData.Weight.Category, m_ObsData._Index, FirstYear, LastYear, FirstAge, LastAge);
   end;
//   SetLength(dataarr, LastYear - FirstYear + 1);
   for Year := FirstYear to LastYear do
   begin
//      SetLength(dataarr[Year], LastAge - FirstAge + 1);
      for Age := FirstAge to LastAge do
      begin
         Val := 0;
         if (Year >= m_FirstYear) and (Year <= m_LastYear) and
            (Age >= m_FirstAge) and (Age <= m_LastAge) then
         begin
            Val := safestrtofloat(sgData.Cells[1 + Age - m_FirstAge, GetNumFixedRows + Year - m_FirstYear]);
         end;
         set_DataSourceValue(m_ObsData.Category, m_ObsData._Index, Year - FirstYear, Age - FirstAge, val);
      end;
   end;
   UpdateView;
end; // TfrmDataSourceDlg.btnApplyDimClick


procedure TfrmDataSourceDlg.sgDataDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
  procedure WriteText(StringGrid: TStringGrid; ACanvas: TCanvas; const ARect: TRect; const Text: string; Format: Word; CellColor : TColor);
  const
    DX = 2;
    DY = 2;
   var
    oldPenColor : TColor;
    _Focused, _Selected : Boolean;
//    pParam : TParamElmPtr;
  begin
    with Stringgrid, ACanvas, ARect do
    begin
      _Focused := (ARow = Row) and (ACol = Col);
      _Selected := (GetSelectionLeft <= ACol) and (ACol <= GetSelectionRight) and
         (GetSelectionTop <= ARow) and (ARow <= GetSelectionBottom);
      if not _Focused and _Selected then
         Brush.Color := clHighlight
      else if not CanSelectCell(ACol, ARow) then
         Brush.Color := $eeeeee
      else
      begin
         Brush.Color := CellColor;
      end;
      FillRect(Rect);
      try
      if Text = '' then
         exit;
      ACanvas.Font.Assign(Stringgrid.Font);
      if not _Focused and _Selected then
      begin
         Font.Color := clHighlightText;
      end
      else
         Font.Color := clWindowText;

      case Format of
        DT_LEFT: ExtTextOut(Handle, Left + DX, Top + DY,
            ETO_OPAQUE or ETO_CLIPPED, @ARect, PChar(Text), Length(Text), nil);

        DT_RIGHT: ExtTextOut(Handle, Right - TextWidth(Text) - 3, Top + DY,
            ETO_OPAQUE or ETO_CLIPPED, @ARect, PChar(Text),
            Length(Text), nil);

        DT_CENTER: ExtTextOut(Handle, Left + (Right - Left - TextWidth(Text)) div 2,
            Top + DY, ETO_OPAQUE or ETO_CLIPPED, @ARect,
            PChar(Text), Length(Text), nil);
      end;
      finally
      oldpencolor := Pen.Color;
      Pen.Color := clBlack;
      if sgData.Focused and _Selected then
      begin
         if ACol = GetSelectionLeft then
         begin
            Canvas.MoveTo(Rect.Left, Rect.Top);
            Canvas.LineTo(Rect.Left, Rect.Bottom);
         end;
         if ACol = GetSelectionRight then
         begin
            Canvas.MoveTo(Rect.Right, Rect.Top);
            Canvas.LineTo(Rect.Right, Rect.Bottom);
         end;
         if ARow = GetSelectionTop then
         begin
            Canvas.MoveTo(Rect.Left, Rect.Top);
            Canvas.LineTo(Rect.Right, Rect.Top);
         end;
         if ARow = GetSelectionBottom then
         begin
            Canvas.MoveTo(Rect.Left, Rect.Bottom);
            Canvas.LineTo(Rect.Right, Rect.Bottom);
         end;
      end; // end if
      Pen.Color := oldPencolor;
      end;
    end;
  end;

  procedure Display(StringGrid: TStringGrid; const S: string; Alignment: TAlignment; CellColor : TColor);
  const
    Formats: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  begin
    WriteText(StringGrid, StringGrid.Canvas, Rect, S, Formats[Alignment], CellColor);
  end;
var
   s : string;
   CellColor : TColor;
begin
   if not g_RunIsLoaded then
      exit;
   sgDataGetEditText(nil, ACol, ARow, s);
   if (ARow = 0) or (Acol = 0) then
      CellColor := clBtnFace
   else
      CellColor := clWindow;
   Display(sgData, s, taRightJustify, CellColor)
end;


procedure TfrmDataSourceDlg.sgDataGetEditText(Sender: TObject; ACol,
  ARow: Integer; var Value: string);
{var
   _Val : Double;
   _Cat, Idx : Integer;}
begin
   if (ACol >= 0) and (ARow >= 0) then
      Value := sgData.Cells[ACol, ARow]
   else
      Value := '';
{   if ARow = 0 then
      Value := inttostr(round(get_Run_Prop(propFirstAge)) + ACol - 1)
   else if ACol = 0 then
      Value := inttostr(round(get_Run_Prop(propFirstYear)) + ARow - 1)
   else if CanSelectCell(ACol, ARow) then
   begin
      _Cat := m_ObsData.Category;
      Idx := m_ObsData._Index;
      get_DataSourceValue_(_Cat, Idx, ARow, ACol, _Val);
      Value := floattostr(_Val);
   end;}
end;

procedure TfrmDataSourceDlg.sgDataKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if sgData.EditorMode and (Key in [VK_LEFT, VK_RIGHT]) then
   begin
      sgData.EditorMode := false;
      case Key of
         VK_LEFT: sgData.Col := max(0, sgData.Col - 1);
         VK_RIGHT: sgData.Col := min(sgData.ColCount - 1, sgData.Col + 1)
      end; // case
   end;
end;

procedure TfrmDataSourceDlg.sgDataKeyPress(Sender: TObject; var Key: Char);
begin
   if Key = ',' then
      Key := DecimalSeparator;
end;

procedure TfrmDataSourceDlg.sgDataKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    if Key = VK_SHIFT then
   begin
      m_RegisterSelTarget := false;
   end;
end;

procedure TfrmDataSourceDlg.sgDataMouseWheelDown(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
   if ssCtrl in Shift then
   begin
      sgData.Font.Size := sgData.Font.Size + 1;
      OptimizeSize;
   end;
end;


procedure TfrmDataSourceDlg.sgDataMouseWheelUp(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
   if ssCtrl in Shift then
   begin
      sgData.Font.Size := max(4, sgData.Font.Size -1);
      OptimizeSize;
   end;
end;

procedure TfrmDataSourceDlg.sgDataSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
   ShiftIsPressed : Boolean;
   _CanSelect : Boolean;
begin
   ShiftIsPressed := (0 <> (GetKeyState(VK_LSHIFT) and $FF00)) or (0 <> (GetKeyState(VK_RSHIFT) and $FF00));
   _CanSelect := CanSelectCell(ACol, ARow);
   CanSelect := _CanSelect;
   if CanSelect then
   begin
      if ShiftIsPressed then
      begin
         if not RegisterSelTarget then
         begin
            SelTargetCol := sgData.Col;
            SelTargetRow := sgData.Row;
            RegisterSelTarget := true;
         end;
      end
      else
      begin
         SelTargetCol := ACol;
         SelTargetRow := ARow;
      end;
   end;
   sgData.Invalidate;
//   sgData.Update;
   if (m_BackDlg <> nil) and (ACol < m_BackDlg.sgData.ColCount) and (ARow < m_BackDlg.sgData.RowCount) then
   begin
      m_BackDlg.sgData.Col := ACol;
      m_BackDlg.sgData.Row := ARow;
      m_BackDlg.sgDataSelectCell(m_BackDlg.sgData, ACol, ARow, CanSelect);
      //m_BackDlg.sgData.Invalidate;
      //m_BackDlg.sgData.Update;
   end;
end;


procedure TfrmDataSourceDlg.sgDataSetEditText(Sender: TObject; ACol,
  ARow: Integer; const Value: string);
begin
   if(m_Pasting) then
      sgData.Cells[ACol, ARow] := Value;
end;

// TfrmDataSourceDlg.sgDataGetEditText

// TfrmDataSourceDlg.sgDataDrawCell


function TfrmDataSourceDlg.GetSelectionLeft : Integer;
begin
   Result := min(sgData.Col, m_SelTargetCol);
end; // TfrmDataSourceDlg.GetSelectionLeft


function TfrmDataSourceDlg.GetSelectionTop : Integer;
begin
   Result := min(sgData.Row, m_SelTargetRow);
end; // TfrmDataSourceDlg.GetSelectionTop


function TfrmDataSourceDlg.GetSelectionRight : Integer;
begin
   Result := max(sgData.Col, m_SelTargetCol);
end; // TfrmDataSourceDlg.GetSelectionRight


function TfrmDataSourceDlg.GetSelectionBottom : Integer;
begin
   Result := max(sgData.Row, m_SelTargetRow);
end; // TfrmDataSourceDlg.GetSelectionBottom


procedure TfrmDataSourceDlg.btnOKClick(Sender: TObject);
begin
   btnApplyDimClick(nil);
   set_Run_Prop_Str(propCaTonFile + (m_ObsData.Category - odCaTon), ebFileName.Text);
   SaveObsData__();
end; // TfrmDataSourceDlg.btnOKClick


procedure TfrmDataSourceDlg.btnWeightingsClick(Sender: TObject);
var
   frmDataSourceDlg : TfrmDataSourceDlg;
begin
   frmDataSourceDlg := TfrmDataSourceDlg.Create(Self, m_ObsData.Weight, Self);
   frmDataSourceDlg.ShowModal;
   frmDataSourceDlg.Free;
end; // TfrmDataSourceDlg.btnWeightingsClick


function TfrmDataSourceDlg.CanSelectCell(ACol, ARow: Integer) : Boolean;
var
   InLastAge, InLastYear : Boolean;
begin
   Result := false;
   with sgData do
   begin
      if (0 < ARow) and (0 < ACol) then
         Result := true
   end; // with
end; // TfrmDataSourceDlg.CanSelectCell


end.
